home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue71 / Construc / DrBobCGI.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  2001-06-04  |  4.7 KB  |  183 lines
  1. unit DrBobCGI;
  2. {===================================================================}
  3. { unit DrBobCGI (c) 1999 by Bob Swart (aka Dr.Bob - www.drbob42.com }
  4. { version 1.0 - obtain standard CGI variable values by "value()".   }
  5. { version 2.0 - obtain CGI values, cookies and IP/UserAgent values. }
  6. {===================================================================}
  7. interface
  8. type
  9.   TRequestMethod = (Unknown,Get,Post);
  10. var
  11.   RequestMethod: TRequestMethod = Unknown;
  12.  
  13. var
  14.   ContentLength: Integer = 0;
  15.   RemoteAddress: String[16] = ''; { IP }
  16.   HttpUserAgent: String[128] = ''; { Browser, OS }
  17.   ScriptName: String[128] = ''; { scriptname URL }
  18.  
  19.   function Value(const Field: ShortString; Convert: Boolean = True): ShortString;
  20.   function CookieValue(const Field: ShortString): ShortString;
  21.  
  22. implementation
  23. uses
  24.   {$IFDEF WIN32}
  25.     Windows,
  26.   {$ENDIF}
  27.   {$IFDEF LINUX}
  28.     Libc,
  29.   {$ENDIF}
  30.     SysUtils;
  31.  
  32.   function _Value(const Field: ShortString;
  33.                   const Data: AnsiString; Sep: Char = '&';
  34.                   Convert: Boolean = True): ShortString;
  35.   { 1998/01/02: check for complete match of Field name }
  36.   { 1999/03/01: do conversion *after* searching fields }
  37.   var
  38.     i: Integer;
  39.     Str: String[3];
  40.     len: Byte absolute Result;
  41.   begin
  42.     len := 0; { Result := '' }
  43.     i := Pos('&'+Field+'=',Data);
  44.     if i = 0 then
  45.     begin
  46.       i := Pos(Field+'=',Data);
  47.       if i > 1 then i := 0
  48.     end
  49.     else Inc(i); { skip '&' }
  50.     if i > 0 then
  51.     begin
  52.       Inc(i,Length(Field)+1);
  53.       while Data[i] <> Sep do
  54.       begin
  55.         Inc(len);
  56.         if (Data[i] = '%') and Convert then // special code
  57.         begin
  58.           Str := '$00';
  59.           Str[2] := Data[i+1];
  60.           Str[3] := Data[i+2];
  61.           Inc(i,2);
  62.           Result[len] := Chr(StrToInt(Str))
  63.         end
  64.         else
  65.           if (Data[i] = ' ') and not Convert then Result[len] := '+'
  66.           else
  67.             Result[len] := Data[i];
  68.         Inc(i)
  69.       end
  70.     end
  71.     else Result := '$' { no javascript }
  72.   end {_Value};
  73.  
  74. var
  75.   Data: AnsiString = '';
  76.  
  77.   function Value(const Field: ShortString; Convert: Boolean = True): ShortString;
  78.   begin
  79.     Result := _Value(Field, Data, '&', Convert)
  80.   end;
  81.  
  82. var
  83.   Cookie: AnsiString = '';
  84.  
  85.   function CookieValue(const Field: ShortString): ShortString;
  86.   begin
  87.     Result := _Value(Field, Cookie, ';');
  88.     if Result = '' then Result := Cookie { debug }
  89.   end;
  90.  
  91. var
  92.   P: PChar;
  93.   i: Integer;
  94. {$IFDEF WIN32}
  95.   Str: ShortString;
  96. {$ENDIF}
  97.  
  98. initialization
  99. {$IFDEF WIN32}
  100. // Tested on IIS and PWS
  101.   P := GetEnvironmentStrings;
  102.   while P^ <> #0 do
  103.   begin
  104.     Str := StrPas(P);
  105.     if Pos('REQUEST_METHOD=',Str) > 0 then
  106.     begin
  107.       Delete(Str,1,Pos('=',Str));
  108.       if Str = 'POST' then RequestMethod := Post
  109.       else
  110.         if Str = 'GET' then RequestMethod := Get
  111.     end;
  112.     if Pos('CONTENT_LENGTH=',Str) = 1 then
  113.     begin
  114.       Delete(Str,1,Pos('=',Str));
  115.       ContentLength := StrToInt(Str)
  116.     end;
  117.     if Pos('QUERY_STRING=',Str) > 0 then
  118.     begin
  119.       Delete(Str,1,Pos('=',Str));
  120.       SetLength(Data,Length(Str)+1);
  121.       Data := Str
  122.     end;
  123.     if Pos('HTTP_COOKIE=',Str) > 0 then
  124.     begin
  125.       Delete(Str,1,Pos('=',Str));
  126.       SetLength(Cookie,Length(Str)+1);
  127.       Cookie := Str
  128.     end
  129.     else
  130.     if Pos('REMOTE_ADDR',Str) = 1 then // TDM #39
  131.     begin
  132.       Delete(Str,1,Pos('=',Str));
  133.       RemoteAddress := Str
  134.     end
  135.     else
  136.     if Pos('HTTP_USER_AGENT',Str) = 1 then // TDM #39
  137.     begin
  138.       Delete(Str,1,Pos('=',Str));
  139.       if Pos(')',Str) > 0 then
  140.         Delete(Str,Pos(')',Str)+1,Length(Str)); {!!}
  141.       HttpUserAgent := Str
  142.     end
  143.     else
  144.     if Pos('SCRIPT_NAME',Str) = 1 then // TDM #71
  145.     begin
  146.       Delete(Str,1,Pos('=',Str));
  147.       ScriptName := Str
  148.     end;
  149.     Inc(P, StrLen(P)+1)
  150.   end;
  151. {$ENDIF}
  152. {$IFDEF LINUX}
  153. // Tested on Apache for Linux
  154.   P := getenv('REQUEST_METHOD');
  155.   if P = 'POST' then RequestMethod := Post
  156.   else
  157.     if P = 'GET' then RequestMethod := Get;
  158.   ContentLength := StrToIntDef(getenv('CONTENT_LENGTH'),0);
  159.   Data := getenv('QUERY_STRING');
  160.   Cookie := StrPas(getenv('HTTP_COOKIE'));
  161.   RemoteAddress := StrPas(getenv('REMOTE_ADDR'));
  162.   HttpUserAgent := StrPas(getenv('HTTP_USER_AGENT'));
  163.   ScriptName := StrPas(getenv('SCRIPT_NAME'));
  164. {$ENDIF}
  165.   if RequestMethod = Post then
  166.   begin
  167.     SetLength(Data,ContentLength+1);
  168.     for i:=1 to ContentLength do read(Data[i]);
  169.     Data[ContentLength+1] := '&';
  170.   { if IOResult <> 0 then { skip }
  171.   end;
  172.   i := 0;
  173.   while i < Length(Data) do
  174.   begin
  175.     Inc(i);
  176.     if Data[i] = '+' then Data[i] := ' '
  177.   end;
  178.   if i > 0 then Data[i+1] := '&'
  179.            else Data := '&';
  180. finalization
  181.   Data := ''
  182. end.
  183.